home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / CRS / crs03.d81 / datafile.sfx / dfprint (.txt) < prev    next >
Commodore BASIC  |  1990-02-12  |  9KB  |  278 lines
  1. 1500 REM DFPRINT FOR DATAFILE 2.9
  2. 1502 CLR:FL=0:PRINT"[147][158]":POKE53281,11:POKE53280,6:GOTO1530
  3. 1504 D$=CHR$(0):MR$=D$:DR$=D$:S=0:B1$=D$:PW=80:CW=0:B$=CHR$(32):RW=5:LW=32
  4. 1506 NC=0:NL=0:PG=0:F1=0:F2=0:F3=0:L$=D$:RL=0:SB$=D$:CR$=CHR$(13):HN$=D$:ID$=D$
  5. 1508 A$=D$:C$=D$:T%=6:I$=D$:CK=0:I=0:J=0:K=0:L=0:M=0:N=0:RW=5:SF=0:Z=0:E$="EOF"
  6. 1510 EN=0:EM$=D$:ET=0:ES=0:A1$=D$:A2$=D$:A3$=D$:S1$=D$
  7. 1512 DIMML$(9,4),PC(10),TT$(5),HC$(9)
  8. 1514 RETURN
  9. 1516 REM--DIMENSION BUFFER ARRAYS
  10. 1518 DIMF$(F+1),T%(F+1),L%(F+1),REC$(F+1):FL=1:RETURN
  11. 1520 REM--GET
  12. 1522 GETA$:IFA$=""THEN1522
  13. 1524 RETURN
  14. 1526 REM--START MENU
  15. 1528 PRINT"[147]          DATAFILE FAST PRINT          ":GOTO1548
  16. 1530 PRINT"[147]          DATAFILE FAST PRINT          "
  17. 1532 PRINT"         BY MIKE KONSHAK (C)1985       "
  18. 1534 PRINT" THIS PROGRAM WILL PRINT A SEQUENTIAL"
  19. 1536 PRINT" FILE, WHICH WAS PREVIOUSLY WRITTEN"
  20. 1538 PRINT" AND FORMATTED BY DATAFILE[146], FIRECTLY"
  21. 1540 PRINT" TO THE PRINTER.  THE ORDER OF THE"
  22. 1542 PRINT" RECORDS WILL BE THE SAME AS THE MOST"
  23. 1544 PRINT" RECENT SORT AS WRITTEN IN THE CURRENT"
  24. 1546 PRINT" FILE.[145]"
  25. 1548 PRINT"       O[146]PEN FILE ON DISK"
  26. 1550 IFFL<>0THEN:PRINT"       R[146]EPEAT  FILE: ";NF$
  27. 1552 PRINT"       $[146] DISK DIRECTORY"
  28. 1554 PRINT"       Q[146]UIT PROGRAM"
  29. 1556 PRINT"       PRESS THE APPROPRIATE KEY       "
  30. 1558 GOSUB1522:IFA$="$"THEN1628
  31. 1560 IFA$="O"THEN1568
  32. 1562 IFA$="R"THEN1584
  33. 1564 IFA$="Q"THENCLOSE5:CLOSE15:CLOSE4:END
  34. 1566 GOTO1558
  35. 1568 REM--INPUT FILE NAME
  36. 1570 CLR:GOSUB1504:OPEN4,4
  37. 1572 PRINT" ENTER NAME OF DATAFILE TO BE READ"
  38. 1574 PRINT"   ";NF$:INPUT"[145] ";NF$:IFNF$=""THEN1528
  39. 1576 OPEN15,8,15
  40. 1578 OPEN5,8,5,"0:DF] "+NF$+",S,R":GOSUB1618:IFEN=62THENGOSUB1620:GOTO1528
  41. 1580 CLOSE5:CLOSE15
  42. 1582 REM--PRINT RECORDS MENU
  43. 1584 PRINT"[147]         RECORD PRINTOUT MENU          "
  44. 1586 PRINT"      L[146]IST UNFORMATTED"
  45. 1588 PRINT"      R[146]EPORT FORMAT"
  46. 1590 PRINT"      M[146]AILING LABELS"
  47. 1592 PRINT"      C[146]HANGE LABEL SIZE"
  48. 1594 PRINT"      S[146]END PRINTER COMMANDS"
  49. 1596 PRINT"      E[146]XIT TO RESTART"
  50. 1598 PRINT"       PRESS THE APPROPRIATE KEY       "
  51. 1600 GOSUB1522:IFA$=""THEN1600
  52. 1602 IFA$="L"THENK=1:GOTO1730
  53. 1604 IFA$="R"THENK=2:GOTO1668
  54. 1606 IFA$="E"THEN1528
  55. 1608 IFA$="M"THENK=3:GOTO1704
  56. 1610 IFA$="C"THEN1940
  57. 1612 IFA$="S"THEN1978
  58. 1614 GOTO1600
  59. 1616 REM--DISK ERROR
  60. 1618 INPUT#15,EN,EM$,ET,ES:IF(EN<20)OR(EN=62)THENET=0:RETURN
  61. 1620 PRINT" [150]DISK ERROR[146]"EN"[157], "EM$","ET"[157],"ES"[158]":ET=8
  62. 1622 PRINT" PRESS ANY KEY[146] TO RESTART PROGRAM"
  63. 1624 GOSUB1522:CLOSE5:CLOSE15:RETURN
  64. 1626 REM--DIRECTORY
  65. 1628 OPEN15,8,15:OPEN5,8,0,"$0":PRINT"[147]":GOSUB1618:IFET=8THEN1528
  66. 1630 GET#5,A1$,A2$
  67. 1632 GET#5,A1$,A2$
  68. 1634 GET#5,A1$,A2$
  69. 1636 IFA1$<>""THENA0=ASC(A1$)
  70. 1638 IFA2$<>""THENA0=A0+ASC(A2$)*256
  71. 1640 PRINTMID$(STR$(A0),2);TAB(3);
  72. 1642 GET#5,A2$:IFST<>0THEN1660
  73. 1644 IFA2$<>CHR$(34)THEN1642
  74. 1646 GET#5,A2$:IFA2$<>CHR$(34)THENPRINT""A2$"[146]";:GOTO1646
  75. 1648 GET#5,A2$:IFA2$=CHR$(32)THEN1648
  76. 1650 PRINTTAB(20);:A3$=""
  77. 1652 A3$=A3$+A2$:GET#5,A2$:IFA2$<>""THEN1650
  78. 1654 PRINTLEFT$(A3$,3)
  79. 1656 GETA$:IFA$<>""THENGOSUB1664
  80. 1658 IFST=0THEN1632
  81. 1660 PRINT" BLOCKS FREE";:A0=0
  82. 1662 CLOSE5:CLOSE15:PRINTTAB(25)"PRESS ANY KEY[146]":GOSUB1522:GOTO1528
  83. 1664 GOSUB1522:RETURN
  84. 1666 REM--LOAD REPORT FORMAT
  85. 1668 PRINT" NAME OF REPORT FORM AT FILE?"
  86. 1670 PRINT"   ";NF$:INPUT"[145] ";RF$:IFRF$=""THEN1528
  87. 1672 OPEN15,8,15:OPEN5,8,5,"0:RP] "+RF$+",S,R":GOSUB1618:IFET=8THEN1528
  88. 1674 IFEN=62THENGOSUB1618:GOTO1528
  89. 1676 INPUT#5,PW,NL,NC:GOSUB1618:IFET=8THEN1528
  90. 1678 FORJ=1TONL
  91. 1680 INPUT#5,TT$(J):GOSUB1618:IFET=8THEN1528
  92. 1682 NEXTJ
  93. 1684 FORI=1TONC
  94. 1686 INPUT#5,PC(I),HC$(I):GOSUB1618:IFET=8THEN1528
  95. 1688 FORN=1TO3
  96. 1690 INPUT#5,ML$(I,N):GOSUB1618:IFET=8THEN1528
  97. 1692 NEXTN:NEXTI:INPUT#5,A1$:Z=VAL(A1$)
  98. 1694 S=ST:IFS<>0THEN1698
  99. 1696 INPUT#5,E$
  100. 1698 CLOSE5:CLOSE15
  101. 1700 GOTO1730
  102. 1702 REM--LOAD MAILING LABEL FORMAT
  103. 1704 PRINT" NAME OF MAILING LABEL FORMAT FILE?"
  104. 1706 PRINT"   ";NF$:INPUT"[145] ";MF$:IFMF$=""THEN1528
  105. 1708 OPEN15,8,15:OPEN5,8,5,"0:ML] "+MF$+",S,R":GOSUB1618:IFET=8THEN1528
  106. 1710 IFEN=62THENGOSUB1620:GOTO1528
  107. 1712 INPUT#5,RW
  108. 1714 FORI=1TORW:FORN=1TO3
  109. 1716 INPUT#5,ML$(I,N):GOSUB1618:IFET=8THEN1528
  110. 1718 NEXTN
  111. 1720 NEXTI
  112. 1722 S=ST:IFS<>0THEN1726
  113. 1724 INPUT#5,E$
  114. 1726 CLOSE5:CLOSE15
  115. 1728 REM--OPEN DATAFILE CHANNEL
  116. 1730 OPEN15,8,15:OPEN5,8,5,"0:DF] "+NF$+",S,R":GOSUB1618:IFET=8THEN1528
  117. 1732 IFEN=62THENGOSUB1620:GOTO1528
  118. 1734 INPUT#5,R,F,X:GOSUB1618:IFET=8THEN1528
  119. 1736 IFFL=0THENGOSUB1518:REM DIMENSION ARRAYS AND BUFFER
  120. 1738 FORN=1TOF:INPUT#5,F$(N),L%(N):NEXTN:GOSUB1618:IFET=8THEN1528
  121. 1740 REM--SEARCH ROUTINES MENU
  122. 1742 A0=0:PRINT"[147]            PRINT OPTIONS MENU        "
  123. 1744 PRINT"    A[146]LL RECORDS IN FILE
  124. 1746 [153]"    FWAITIND RECORDS WITH COMMON FIELDS
  125. 1748 IFK=3THENPRINT"    T[146]EST LABEL(S)"
  126. 1750 PRINT"    E[146]XIT BACK TO START"
  127. 1752 IFK=2THENPRINT"POSITION PAPER IN PRINTER AT TOP OF PAGE"
  128. 1754 PRINT"       PRESS THE APPROPRIATE KEY       "
  129. 1756 GETC$:IFC$=""THEN1756
  130. 1758 IFC$="A"THEN1806
  131. 1762 IFC$="T"THEN1918
  132. 1764 IFC$="F"THEN1772
  133. 1766 IFC$="E"THENCLOSE5:CLOSE15:GOTO1528
  134. 1768 GOTO1756
  135. 1770 REM--FIND RECORD (SEARCH)
  136. 1772 PRINT"[147]     FIND RECORDS WITH COMMON ITEMS    "
  137. 1774 FORN=1TOF:PRINT" ";N;"[146] ";F$(N):NEXTN
  138. 1776 INPUT" WHICH FIELD IS TO BE SEARCHED";SF
  139. 1778 IFSF<0ORSF>FTHENPRINT"[145][145][145]":GOTO1776
  140. 1780 PRINT" ENTER COMMON ITEM[146] ":PRINT" (THE ENTIRE STRING IS NOT REQUIRED)"
  141. 1782 PRINT" ";F$(SF);"[146] ";:INPUTT$
  142. 1784 IFK=2THENGOSUB1838:GOSUB1852
  143. 1786 FORI=1TOX
  144. 1788 PRINT" SEARCHING RECORD";I;"[145][145]"
  145. 1790 FORN=1TOF:INPUT#5,REC$(N):NEXTN:GOSUB1618:IFET=8THEN1528
  146. 1792 IFT$=LEFT$(REC$(SF),LEN(T$))THENONKGOSUB1826,1870,1928
  147. 1794 IFK=2THENGOSUB1904
  148. 1796 NEXTI
  149. 1798 CLOSE5:CLOSE15
  150. 1800 IFK=2THEN1906
  151. 1802 GOTO1528
  152. 1804 REM--PRINT ALL RECORDS
  153. 1806 PRINT" PRINTING HEADING":IFK=2THENGOSUB1838:GOSUB1852
  154. 1808 FORI=1TOX:PRINT"[145] READING RECORD #";I
  155. 1810 FORN=1TOF:INPUT#5,REC$(N):NEXTN:GOSUB1618:IFET=8THEN1528
  156. 1812 ONKGOSUB1826,1870,1928
  157. 1814 IFK=2THENGOSUB1904
  158. 1816 NEXTI
  159. 1818 CLOSE5:CLOSE15
  160. 1820 IFK=2THEN1906
  161. 1822 GOTO1528
  162. 1824 REM--PRINT NONFORMATTED LISTING
  163. 1826 PRINT#4,"[ RECORD #";I;"   ]";:FORJ=1TO62:PRINT#4,"-";:NEXTJ:PRINT#4,B1$
  164. 1828 FORN=1TOF
  165. 1830 PRINT#4,F$(N);:FORJ=1TO20-LEN(F$(N)):PRINT#4,".";:NEXTJ
  166. 1832 PRINT#4,REC$(N)
  167. 1834 NEXTN:PRINT#4,B1$:RETURN
  168. 1836 REM--PRINT REPORT
  169. 1838 PG=0:S$="":FORJ=1TOPW:S$=S$+B$:NEXTJ
  170. 1840 FORJ=1TONL:IFTT$=(J)<>">"THENGOSUB1846
  171. 1842 NEXTJ:RETURN
  172. 1844 REM--CENTER TITLE
  173. 1846 B=INT((PW-LEN(TT$(J)))/2)
  174. 1848 PRINT#4,LEFT$(S$,B)+TT$(J);B1$:PG=PG+1:RETURN
  175. 1850 REM--POSITION HEADINGS
  176. 1852 GOSUB1866:PC(NC+1)=PW+3:CW=PC(2)-2-PC(1):IFPC(1)>1THEN1856
  177. 1854 PRINT#4,LEFT$(HC$(1),CW);:GOTO1858
  178. 1856 PRINT#4,LEFT$(S$,PC(1)-1)+LEFT$(HC$(1),CW);
  179. 1858 FORJ=2TONC:M=PC(J)-LEN(LEFT$(HC$(J-1),PC(J)-2-PC(J-1)))-PC(J-1)
  180. 1860 PRINT#4,LEFT$(S$,M)+LEFT$(HC$(J),PC(J+1)-2-PC(J));
  181. 1862 NEXTJ:PRINT#4,B1$:GOSUB1866:PG=PG+3:RETURN
  182. 1864 REM--PRINT DASHED LINE
  183. 1866 FORJ=1TOPW:PRINT#4,"-";:NEXTJ:PRINT#4,B1$:RETURN
  184. 1868 REM--PRINT REPORT FILE DATA
  185. 1870 F1=VAL(ML$(1,1)):F2=VAL(ML$(1,2)):F3=VAL(ML$(1,3)):CW=PC(2)-2-PC(1)
  186. 1872 IFPC(1)>1THEN1878
  187. 1874 PRINT#4,LEFT$(REC$(F1)+B$+REC$(F2)+B$+REC$(F3),CW);
  188. 1876 GOTO1882
  189. 1878 PRINT#4,LEFT$(S$,PC(1)-1);
  190. 1880 PRINT#4,LEFT$(REC$(F1)+B$+REC$(F2)+B$+REC$(F3),CW);
  191. 1882 FORJ=2TONC:CW=PC(J)-2-PC(J-1)
  192. 1884 F1=VAL(ML$(J-1,1)):F2=VAL(ML$(J-1,2)):F3=VAL(ML$(J-1,3))
  193. 1886 M=LEN(LEFT$(REC$(F1)+B$+REC$(F2)+B$+REC$(F3),CW))
  194. 1888 M=PC(J)-M-PC(J-1):CW=PC(J+1)-2-PC(J)
  195. 1890 PRINT#4,LEFT$(S$,M);
  196. 1892 F1=VAL(ML$(J,1)):F2=VAL(ML$(J,2)):F3=VAL(ML$(J,3))
  197. 1894 PRINT#4,LEFT$(REC$(F1)+B$+REC$(F2)+B$+REC$(F3),CW);
  198. 1896 NEXTJ:PRINT#4,B1$:PG=PG+1
  199. 1898 IFPG=60THENFORJ=1TO6:PRINT#4,B1$:NEXTJ:PG=0:GOSUB1852
  200. 1900 RETURN
  201. 1902 REM--SUM LAST COLUMN
  202. 1904 IFZ<>1THENRETURN
  203. 1905 A0=A0+VAL(REC$(VAL(ML$(NC,1)))):RETURN
  204. 1906 IFZ<>1THENPRINT#4,B1$:GOTO1528
  205. 1908 PRINT#4,LEFT$(S$,PC(NC)-1);
  206. 1910 FORI=1TOPW-PC(NC)+1:PRINT#4,"-";:NEXTI:PRINT#4,B1$
  207. 1912 PRINT#4,LEFT$(S$,PC(NC)-9)+"TOTAL= "+STR$(A0)
  208. 1914 PRINT#4,B1$:GOTO1528
  209. 1916 REM--PRINT SAMPLE LABELS
  210. 1918 PRINT" PRINTING TEST LABEL"
  211. 1920 FORI=1TORW:FORJ=1TOLW:PRINT#4,RIGHT$(STR$(J),1);:NEXTJ:PRINT#4,B1$:NEXTI
  212. 1922 FORI=1TOT%-RW:PRINT#4,B1$:NEXTI
  213. 1924 GOTO1742
  214. 1926 REM--PRINT LABELS
  215. 1928 FORJ=1TORW:F1=VAL(ML$(J,1)):F2=VAL(ML$(J,2)):F3=VAL(ML$(J,3))
  216. 1930 PRINT#4,LEFT$(REC$(F1)+B$+REC$(F2)+B$+REC$(F3),LW)
  217. 1932 NEXTJ
  218. 1934 FORS=1TOT%-RW:PRINT#4,B1$:NEXTS
  219. 1936 RETURN
  220. 1938 REM--CHOOSE LABEL SIZE
  221. 1940 PRINT"[147]             LABEL SIZE               [146]"
  222. 1942 PRINT"    S[146]TANDARD - 5 ROWS PER LABEL"
  223. 1944 PRINT"      15/16 INCH BY 3 1/2 INCHES"
  224. 1946 PRINT"    L[146]ARGE    - 8 ROWS PER LABEL"
  225. 1948 PRINT"      1 7/16 INCH BY 3 1/2 INCHES"
  226. 1950 PRINT"    O[146]THER    - CUSTOM LABEL SIZE OR"
  227. 1952 PRINT"      NUMBER OF CHARACTERS PER ROW"
  228. 1954 PRINT" NOTE: LABELS ARE SEPARATED BY ONE ROW"
  229. 1956 PRINT" 32 CHARACTERS PER ROW IS STANDARD"
  230. 1958 PRINT"       PRESS THE APPROPRIATE KEY       "
  231. 1960 GETC$:IFC$=""THEN1960
  232. 1962 IFC$="S"THENT%=6:RW=5:LW=32:GOTO1584
  233. 1964 IFC$="L"THENT%=9:RW=8:LW=32:GOTO1584
  234. 1966 IFC$="O"THEN1970
  235. 1968 GOTO1960
  236. 1970 INPUT" ENTER NUMBER OF ROWS ON LABEL";RW:T%=RW+1
  237. 1972 INPUT" ENTER # OF CHARACTERS PER ROW";LW
  238. 1974 GOTO1584
  239. 1976 REM--SEND PRINTER CODES
  240. 1978 PRINT"[147]            PRINTER COMMAND            [146]"
  241. 1980 PRINT" THIS ROUTINE WILL SEND CHARACTER"
  242. 1982 PRINT" STRING [CHR$()] COMMANDS TO AN ASCII"
  243. 1984 PRINT" PRINTER.  COMMANDS MUST BE ENTERED IN"
  244. 1986 PRINT" THE FORM OF INTEGERS SUCH AS:"
  245. 1988 PRINT" ? 27     (ESCAPE CODE)"
  246. 1990 PRINT" ? 66     (PITCH CODE)"
  247. 1992 PRINT" ? 2      (COMPRESSED MODE)"
  248. 1994 PRINT" ? *      (END THE SEQUENCE)"
  249. 1996 PRINT" THIS WILL BE SENT TO THE PRINTER AS:"
  250. 1998 PRINT"   PRINT#4,CHR$(27)CHR$(66)CHR$(2)"
  251. 2000 PRINT" UP TO FOUR(4) NUMBERS MAY BE SENT,"
  252. 2002 PRINT" THE FIRST NORMALLY BEING 27[146], THE"
  253. 2004 PRINT" ESCAPE CHARACTER.  END THE SEQUENCE"
  254. 2006 PRINT" IS SHOWING.  PRINTERS WILL VARY, SO"
  255. 2008 PRINT" IS SHOWING.  PRINTERS WILL VARY, SO"
  256. 2010 PRINT" CHECK YOUR MANUAL FOR THE CODES."
  257. 2012 PRINT"    ANY KEY[146] TO CONTINUE OR E[146]XIT?"
  258. 2014 GOSUB1522:IFA$="E"THEN1584
  259. 2016 PRINT"[147]         SEND PRINTER COMMAND          [146]"
  260. 2018 PRINT" ENTER CODE, THEN PRESS RETURN[146]"
  261. 2020 PRINT" RETURN[146] ONLY TO QUIT"
  262. 2022 FORI=1TO4:PRINT"CODE";I;" ? * [157][157][157][157]";:INPUTI$(I)
  263. 2024 IFI$(I)="*"THEN2028
  264. 2026 NEXTI
  265. 2028 ONIGOTO2030,2032,2034,2036
  266. 2030 PRINT#4,CHR$(VAL(I$(1))):GOTO2038
  267. 2032 PRINT#4,CHR$(VAL(I$(1)))CHR$(VAL(I$(2))):GOTO2038
  268. 2034 PRINT#4,CHR$(VAL(I$(1)))CHR$(VAL(I$(2)))CHR$(VAL(I$(3))):GOTO2038
  269. 2036 PRINT#4,CHR$(VAL(I$(1)))CHR$(VAL(I$(2)))CHR$(VAL(3)))CHR$(VAL(I$(4)))
  270. 2038 PRINT"          A[146]NOTHER CODE"
  271. 2040 PRINT"          T[146]EST CHANGE"
  272. 2042 PRINT"          E[146]XIT TO PRINT"
  273. 2044 PRINT"       PRESS THE APPROPRIATE KEY       "
  274. 2046 GOSUB1522:IFA$="A"THEN2016
  275. 2048 IFA$="T"THENPRINT#4,"ABCDEFGHIJKLMNOPQRSTUVWXYZ":GOTO2046
  276. 2050 IFA$="E"THEN1584
  277. 2052 GOTO2046
  278.